home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / mxcode / adnmod02 / adnmod.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-15  |  19.6 KB  |  929 lines
  1. {$m 8000,60000,230000}
  2. uses crt,dos,modunit;
  3. const
  4. col_backr = 0;
  5. col_backg = 0;
  6. col_backb = 10;
  7. col_back = 2;
  8.  
  9. per_txt : array[0..48] of string[3] = ('   ',
  10.           'C-1','C#1','D-1','D#1','E-1','F-1',
  11.           'F#1','G-1','G#1','A-1','A#1','B-1',
  12.           'C-2','C#2','D-2','D#2','E-2','F-2',
  13.           'F#2','G-2','G#2','A-2','A#2','B-2',
  14.           'C-3','C#3','D-3','D#3','E-3','F-3',
  15.           'F#3','G-3','G#3','A-3','A#3','B-3',
  16.           'C-4','C#4','D-4','D#4','E-4','F-4',
  17.           'F#4','G-4','G#4','A-4','A#4','B-4');
  18. hex_tbl : array[0..15] of char = ('0','1','2','3','4','5','6','7',
  19.                                   '8','9','A','B','C','D','E','F');
  20. fx_txt : array[0..15] of string[3] = (        {downcase means fx not}
  21.          'ARP','PR^','PRv','TON','vib','T&S', {correctly supported}
  22.          'V&S','trm','---','SO=','VLs','JMP',
  23.          'VL=','BRK','EFX','SPD');
  24.  
  25. efx_txt : array[0..15] of string[4] = (
  26.          'filt','FPR^','FPRv','glis','vibf',
  27.          'FTUN','loop','trmf','PAN=','TRIG',
  28.          'FVL^','FVLv','NCUT','NDEL','pdel',
  29.          'funk');
  30.  
  31. {$i adnpic.inc}
  32.  
  33. var
  34.   gusmem : longint;
  35.   start_sample : integer;
  36.  
  37.   old_row : integer;
  38.   mod_name : string;
  39.   pause : byte;
  40.   oldint8,oldint9 : procedure;
  41.   alt_tab : boolean;
  42.  
  43. procedure hide_cursor; assembler;
  44. asm
  45.   mov  ax,0100h
  46.   mov  cx,2607h
  47.   int  10h
  48. end;
  49.  
  50. procedure wait_vr; assembler;
  51. asm
  52.   mov  dx,3dah
  53. @@1:
  54.   in   al,dx
  55.   test al,8
  56.   jz   @@1
  57. end;
  58.  
  59. procedure wait_novr; assembler;
  60. asm
  61.   mov  dx,3dah
  62. @@1:
  63.   in   al,dx
  64.   test al,8
  65.   jnz  @@1
  66. end;
  67.  
  68. procedure setvgapal(pal,col1,col2,col3 : byte); assembler;
  69. asm
  70.   mov  dx,3c8h
  71.   mov  al,pal
  72.   out  dx,al
  73.   inc  dx
  74.   mov  al,col1
  75.   out  dx,al
  76.   mov  al,col2
  77.   out  dx,al
  78.   mov  al,col3
  79.   out  dx,al
  80. end;
  81.  
  82. procedure set_scr_ofs(ofs : word); assembler;
  83. asm
  84.   pushf
  85.   cli
  86.   mov  bx,ofs
  87.   mov  dx,$3d4
  88.   mov  al,0Ch       {Start address high}
  89.   out  dx,al
  90.   inc  dx
  91.   mov  al,bh
  92.   out  dx,al
  93.   dec  dx
  94.   mov  al,0Dh      {Start address high}
  95.   out  dx,al
  96.   inc  dx
  97.   mov  al,bl
  98.   out  dx,al
  99.   popf
  100. end;
  101.  
  102. procedure line_comp(lc : word);
  103. var
  104. b : byte;
  105. begin
  106.   port[$3d4] := 7;
  107.   if lc and 256 > 0 then b := 31
  108.   else b := 15;
  109.   port[$3d5] := b;
  110.   port[$3d4] := 9;
  111.   port[$3d5] := 7;
  112.   port[$3d4] := $18;
  113.   port[$3d5] := lo(lc);
  114. end;
  115.  
  116.  
  117. {function keypressed : boolean;
  118. var
  119. b : byte;
  120. begin
  121.   b := 0;
  122.   asm
  123.     mov  ah,1
  124.     int  16h
  125.     jz  @@1
  126.     mov  b,1
  127. @@1:
  128.   end;
  129.   if b = 0 then keypressed := false
  130.   else keypressed := true;
  131. end;
  132.  
  133. function readkey : char;
  134. var
  135. c : char;
  136. begin
  137.   asm
  138.     xor ax,ax
  139.     int 16h
  140.     mov c,al
  141.   end;
  142.   readkey := c;
  143. end;}
  144. {$s-}
  145. procedure fillattr(x,y,xl : integer; attr : byte); assembler;
  146. asm
  147.   mov  ax,0b800h
  148.   mov  es,ax
  149.   mov  di,y
  150.   dec  di
  151.   mov  ax,160
  152.   mul  di
  153.   dec  x
  154.   add  ax,x
  155.   add  ax,x
  156.   mov  di,ax
  157.   inc  di
  158.   mov  cx,xl
  159.   mov  al,attr
  160. @@1:
  161.   mov  es:[di],al
  162.   add  di,2
  163.   loop @@1
  164. end;
  165.  
  166. procedure fastwrite(x,y : word;s : string);
  167. begin
  168. {l := byte(s[0]);
  169. if l = 0 then exit;
  170. for n := 1 to l do mem[$b800:(y-1)*160+(x-1)*2+n*2-2] := byte(s[n]);}
  171. asm
  172.     push ds
  173.     mov  ax,ss
  174.     mov  ds,ax
  175.     mov  ax,0b800h
  176.     mov  es,ax
  177.     lea  si,s
  178.     lodsb
  179.     cmp  al,0
  180.     jne  @@2
  181.     ret
  182. @@2:
  183.     mov  cl,al
  184.     xor  ch,ch
  185.     mov  di,y
  186.     dec  di
  187.     dec  x
  188.     mov  ax,160
  189.     mul  di
  190.     mov  di,ax
  191.     add  di,x
  192.     add  di,x
  193. @@1:
  194.     movsb
  195.     inc  di
  196.     loop @@1
  197.     pop  ds
  198. end;
  199. end;
  200.  
  201. procedure fastwritel(x,y,l : word;s : string);
  202. begin
  203. asm
  204.     push ds
  205.     mov  ax,ss
  206.     mov  ds,ax
  207.     mov  ax,0b800h
  208.     mov  es,ax
  209.     lea  si,s
  210.     inc  si
  211.     mov  cx,l
  212.     cmp  cx,0
  213.     jne  @@2
  214.     ret
  215. @@2:
  216.     mov  di,y
  217.     dec  di
  218.     dec  x
  219.     mov  ax,160
  220.     mul  di
  221.     mov  di,ax
  222.     add  di,x
  223.     add  di,x
  224. @@1:
  225.     movsb
  226.     inc  di
  227.     loop @@1
  228.     pop  ds
  229. end;
  230. end;
  231.  
  232. procedure scroll_up(y1,yl : word); assembler;
  233. asm
  234.   mov  ax,y1
  235.   mov  cx,160
  236.   mul  cx
  237.   mov  y1,ax
  238.   push ds
  239.   mov  ax,0b800h
  240.   mov  ds,ax
  241.   mov  es,ax
  242.   mov  si,y1
  243.   add  si,160
  244.   mov  di,y1
  245.   mov  bx,yl
  246. @@1:
  247.   mov  cx,80
  248.   rep  movsw
  249.   dec  bx
  250.   jnz  @@1
  251.   pop  ds
  252. end;
  253.  
  254. function byte2hex(b : byte) : string;
  255. begin
  256.   byte2hex := hex_tbl[b shr 4]+hex_tbl[b and 15];
  257. end;
  258.  
  259. function nibb2hex(b : byte) : char;
  260. begin
  261.   nibb2hex := hex_tbl[b and 15];
  262. end;
  263.  
  264. function int2str(i,n : integer) : string;
  265. var
  266. s : string;
  267. begin
  268.   str(i:n,s);
  269.   int2str := s;
  270. end;
  271.  
  272. function word2str(i,n : word) : string;
  273. var
  274. s : string;
  275. begin
  276.   str(i:n,s);
  277.   word2str := s;
  278. end;
  279.  
  280. procedure showbyte(x,y : integer;b : byte); assembler;
  281. asm
  282.   dec  y
  283.   dec  x
  284.   mov  ax,0b800h
  285.   mov  es,ax
  286.   mov  di,y
  287.   mov  ax,160
  288.   mul  di
  289.   mov  di,ax
  290.   add  di,x
  291.   add  di,x
  292.   mov  ah,0
  293.   mov  al,b
  294.   mov  cl,10
  295.   div  cl
  296.   add  ax,3030h
  297.   mov  es:[di],al
  298.   add  di,2
  299.   mov  es:[di],ah
  300. end;
  301.  
  302. procedure showint3(x,y : integer;w : word); assembler;
  303. asm
  304.   dec  y
  305.   dec  x
  306.   mov  ax,0b800h
  307.   mov  es,ax
  308.   mov  di,y
  309.   mov  ax,160
  310.   mul  di
  311.   mov  di,ax
  312.   add  di,x
  313.   add  di,x
  314.   mov  ax,w
  315.   mov  cl,100
  316.   div  cl
  317.   mov  bx,ax
  318.   add  al,30h
  319.   mov  es:[di],al
  320.   add  di,2
  321.   mov  al,bh
  322.   mov  ah,0
  323.   mov  cl,10
  324.   div  cl
  325.   add  ax,3030h
  326.   mov  es:[di],al
  327.   add  di,2
  328.   mov  es:[di],ah
  329. end;
  330.  
  331. procedure showhex(x,y : integer;b : byte);
  332. begin
  333.   mem[$b800:(y-1)*160+2*x-2] := byte(hex_tbl[b shr 4]);
  334.   mem[$b800:(y-1)*160+2*x] := byte(hex_tbl[b and 15]);
  335. end;
  336.  
  337. {$s+}
  338. procedure show_pic; assembler;
  339. asm
  340.   mov  ax,0b800h
  341.   mov  es,ax
  342.   mov  dx,0
  343.   mov  ax,700h
  344.   mov  cx,0
  345.   mov  si,offset imagedata
  346.   xor  di,di
  347. @@start:
  348.   lodsb
  349.   cmp  al,8
  350.   jae  @@char
  351.   cmp  al,0
  352.   je   @@end
  353.   cmp  al,1
  354.   je   @@attr
  355.   cmp  al,2
  356.   je   @@pack
  357.   cmp  al,3
  358.   je   @@space
  359.   jmp  @@start
  360. @@attr:
  361.   lodsb
  362.   mov  ah,al
  363.   jmp  @@start
  364. @@space:
  365.   lodsb
  366.   mov  cl,al
  367.   mov  al,32
  368.   rep  stosw
  369.   jmp  @@start
  370. @@pack:
  371.   lodsb
  372.   mov  cl,al
  373.   lodsb
  374.   rep  stosw
  375.   jmp  @@start
  376. @@char:
  377.   stosw
  378.   jmp  @@start
  379. @@end:
  380. end;
  381.  
  382. function per2note(per : word) : string;
  383. var
  384. n,n2 : integer;
  385. s : string[3];
  386. begin
  387.   n2 := 0;
  388.   for n := 1 to 48 do begin
  389.     if per_table[0,n] = per then begin
  390.       n2 := n;
  391.       n := 48;
  392.     end;
  393.   end;
  394.   if n2 = 0 then if per = 0 then per2note := '...'
  395.   else per2note := '???'
  396.   else per2note := per_txt[n2];
  397. end;
  398.  
  399. procedure show_sample(sam,x,y : integer);
  400. begin
  401.   fastwrite(x,y,int2str(sam,2));
  402.   fastwritel(x+4,y,22,samples[sam].name);
  403.   fastwrite(x+31,y,word2str(samples[sam].length,5));
  404.   fastwrite(x+39,y,word2str(samples[sam].loopstart,5));
  405.   fastwrite(x+47,y,word2str(samples[sam].loopend,5));
  406.   if samples[sam].ftune > 7 then
  407.     fastwrite(x+55,y,int2str(samples[sam].ftune or $fff0,2))
  408.   else fastwrite(x+55,y,int2str(samples[sam].ftune,2));
  409.   fastwrite(x+61,y,int2str(samples[sam].volume,2));
  410. end;
  411. {$s-}
  412. procedure bar(x,y,l : integer;c : char); assembler;
  413. asm
  414.   mov  ax,0b800h
  415.   mov  es,ax
  416.   mov  di,y
  417.   dec  di
  418.   mov  ax,160
  419.   mul  di
  420.   dec  x
  421.   add  ax,x
  422.   add  ax,x
  423.   mov  di,ax
  424.   cmp  l,0
  425.   jz   @@3
  426.   mov  cx,l
  427.   mov  al,c
  428. @@1:
  429.   stosb
  430.   inc  di
  431.   dec  cx
  432.   jnz  @@1
  433. @@3:
  434.   mov  cx,17
  435.   sub  cx,l
  436.   mov  al,32
  437. @@2:
  438.   stosb
  439.   inc  di
  440.   dec  cx
  441.   jnz  @@2
  442. end;
  443.  
  444. procedure show_chn(chn,st : byte);
  445. var
  446. fx,fxdata : byte;
  447. start : integer;
  448. begin
  449.   start := 5-st;
  450.   inc(chn,st);
  451.   fx := channels[chn].fx;
  452.   fxdata := channels[chn].fxdata;
  453.   if channels[chn].on = 1 then
  454.     fastwritel(3,chn+start,22,samples[channels[chn].sample].name)
  455.   else fastwritel(3,chn+start,22,'     ---MUTED---        ');
  456.   fastwrite(30,chn+start,int2str(channels[chn].vol,2));
  457.   fastwritel(34,chn+start,3,per_txt[channels[chn].note]);
  458.   fastwrite(38,chn+start,int2str(channels[chn].per,3));
  459.   fastwrite(43,chn+start,int2str(channels[chn].dper,3));
  460.   fastwrite(54,chn+start,int2str(channels[chn].pan-7,2));
  461.   if fx = 14 then
  462.     fastwritel(47,chn+start,5,efx_txt[fxdata shr 4]+nibb2hex(fxdata and 15))
  463.   else if ((fx < 16) and (fx >0)) or ((fx = 0) and (fxdata > 0)) then
  464.     fastwritel(47,chn+start,5,fx_txt[fx]+byte2hex(fxdata))
  465.   else fastwritel(47,chn+start,5,'     ');
  466.   bar(61,chn+start,(channels[chn].bar+2) div 4,'≈');
  467.   if channels[chn].hit = 1 then begin
  468.     fillattr(3,chn+start,22,15);
  469.     fillattr(30,chn+start,26,15);
  470.   end else begin
  471.     fillattr(3,chn+start,22,7);
  472.     fillattr(30,chn+start,26,7);
  473.   end;
  474.   channels[chn].hit := 0;
  475. end;
  476. {$s+}
  477.  
  478. procedure show_ptn(start_chn : integer;clear : boolean);
  479. var
  480.   ptn : word;
  481.  
  482. procedure show_row(row : integer);
  483. const
  484. wid = 16;
  485. x = 11;
  486. var
  487.   n : integer;
  488.   sam : integer;
  489.   fx,fxdata : byte;
  490.   chn : integer;
  491. begin
  492.   fastwrite(8,26,byte2hex(row)+':');
  493.  
  494.   for n := 0 to 3 do begin
  495.     chn := start_chn+n;
  496.     fastwrite(n*wid+x+2,26,per2note(patterns[ptn]^[row,chn].per)+' ');
  497.     sam := patterns[ptn]^[row,chn].sample;
  498.     if sam > 0 then fastwrite(n*wid+x+6,26,byte2hex(sam)+' ')
  499.     else fastwrite(n*wid+x+6,26,'.. ');
  500.     fx := patterns[ptn]^[row,chn].fx;
  501.     fxdata := patterns[ptn]^[row,chn].fxdata;
  502.     case fx of
  503.       0 : if fxdata > 0 then
  504.             fastwrite(n*wid+x+9,26,fx_txt[fx]+byte2hex(fxdata))
  505.           else fastwrite(n*wid+x+9,26,'     ');
  506.       1..$D : fastwrite(n*wid+x+9,26,fx_txt[fx]+byte2hex(fxdata));
  507.       $E : fastwrite(n*wid+x+9,26,efx_txt[fxdata shr 4]+nibb2hex(fxdata and 15));
  508.       $F : fastwrite(n*wid+x+9,26,fx_txt[fx]+byte2hex(fxdata));
  509.     else fastwrite(n*wid+x+9,26,'     ');
  510.     end;
  511.   end;
  512. end;
  513.  
  514. procedure show_info;
  515. begin
  516.   fastwrite(30,12,int2str(amp_vol,2));
  517.   fastwrite(41,12,int2str(speed,2));
  518.   if not vblank then fastwrite(53,12,int2str(tempo,3)+'   ')
  519.   else fastwrite(53,12,'VBlank');
  520.   fastwrite(30,13,int2str(cur_ptn,2)+'/'+int2str(header.length-1,2));
  521.   fastwrite(41,13,int2str(ptn,2)+'/'+int2str(max_ptn-1,2));
  522.   fastwrite(53,13,int2str(cur_row,2));
  523. end;
  524.  
  525. var
  526.  i : integer;
  527.  kbf : byte;
  528.  s : string;
  529. begin
  530.   fastwritel(30,11,20,header.name);
  531.   for i := 0 to 20 do show_sample(i+start_sample,9,i+30);
  532.   if clear then begin
  533.     s := '                                                                   ';
  534.     for i := 0 to 7 do fastwritel(8,18+i,65,s);
  535.   end;
  536.   repeat
  537.     ptn := orders[cur_ptn];
  538.     wait_vr;
  539.     kbf := mem[$40:$17] and 15;
  540.     if channels[start_chn].hit=1 then kbf := kbf or $20;
  541.     if channels[start_chn+1].hit=1 then kbf := kbf or $40;
  542.     if channels[start_chn+2].hit=1 then kbf := kbf or $10;
  543.     mem[$40:$17] := kbf;
  544.     for i := 0 to 3 do show_chn(i,start_chn);
  545.     show_info;
  546.     time_counter2 := 0;
  547.     if cur_row <> old_row then begin
  548.       old_row := cur_row;
  549.       fillattr(13,26,60,7+2*16);
  550.       scroll_up(17,8);
  551.       show_row(cur_row);
  552.       fillattr(13,26,60,15+2*16);
  553.     end;
  554.   until keypressed;
  555.   mem[$40:$17] := mem[$40:$17] and 15;
  556. end;
  557.  
  558. {$s-,i-}
  559. procedure int9; interrupt;
  560. begin
  561.   if (mem[$40:$17] and 8 > 0) and (port[$60] = $f) then
  562.     if alt_tab then begin
  563.       alt_tab := false;
  564.     end
  565.     else begin
  566.       alt_tab := true;
  567.     end;
  568.   asm pushf end;
  569.   oldint9;
  570. end;
  571.  
  572. procedure fwritel(x,y,l : integer;s : pointer); assembler;
  573. asm
  574.   push ds
  575.   mov  ax,word ptr s+2
  576.   mov  ds,ax
  577.   mov  ax,0b800h
  578.   mov  es,ax
  579.   mov  si,word ptr s
  580.   inc  si
  581.   mov  cx,l
  582.   cmp  cx,0
  583.   jne  @@2
  584.   ret
  585. @@2:
  586.   mov  di,y
  587.   dec  di
  588.   dec  x
  589.   mov  ax,160
  590.   mul  di
  591.   mov  di,ax
  592.   add  di,x
  593.   add  di,x
  594. @@1:
  595.   movsb
  596.   inc  di
  597.   loop @@1
  598.   pop  ds
  599. end;
  600.  
  601. procedure int8; interrupt;
  602. var
  603. n : integer;
  604. p : longint;
  605. fx,fxdata : byte;
  606. begin
  607.   asm pushf end;
  608.   oldint8;
  609.   if alt_tab then begin
  610.     showbyte(53,13+50,cur_row);
  611.     showbyte(41,12+50,speed);
  612.     showbyte(30,13+50,cur_ptn);
  613.     showbyte(33,13+50,header.length-1);
  614.     showbyte(41,13+50,orders[cur_ptn]);
  615.     showbyte(44,13+50,max_ptn-1);
  616.     for n := 0 to 3 do begin
  617.       fx := channels[n].fx;
  618.       fxdata := channels[n].fxdata;
  619.       p := longint(@samples[channels[n].sample].name)-1;
  620.       fwritel(3,n+55,22,pointer(p));
  621.       showbyte(30,n+55,channels[n].vol);
  622.       fwritel(34,n+55,3,@per_txt[channels[n].note]);
  623.       showint3(38,n+55,channels[n].per);
  624.       showint3(43,n+55,channels[n].dper);
  625.       if fx = 14 then begin
  626.         showhex(50,n+55,fxdata and 15);
  627.         fwritel(47,n+55,4,@efx_txt[fxdata shr 4]);
  628.       end
  629.       else if (fx < 16) and (fx >0) then begin
  630.         fwritel(47,n+55,3,@fx_txt[fx]);
  631.         showhex(50,n+55,fxdata);
  632.       end;
  633.       if fx > 15 then fillchar(mem[$b800:(n+54)*160+46*2],10,0);
  634.       bar(61,55+n,(channels[n].bar+2) div 4,'≈');
  635.       if channels[n].hit = 1 then begin
  636.         fillattr(3,n+55,22,15);
  637.         fillattr(30,n+55,26,15);
  638.       end else begin
  639.         fillattr(3,n+55,22,7);
  640.         fillattr(30,n+55,26,7);
  641.       end;
  642.     end;
  643.   end;
  644. end;
  645. {$s+,i+}
  646.  
  647. procedure init_dos;
  648. begin
  649.   alt_tab := true;
  650.   getintvec(9,@oldint9);
  651.   getintvec(8,@oldint8);
  652.   asm
  653.     cld
  654.     push ds
  655.     mov  ax,0B800h
  656.     mov  es,ax
  657.     mov  ds,ax
  658.     mov  si,0
  659.     mov  di,8000
  660.     mov  cx,80*13
  661.     rep  movsw
  662.     pop  ds
  663.  
  664.     mov  di,0
  665.     mov  cx,4000
  666.     mov  ax,0720h
  667.     rep  stosw
  668.   end;
  669.   mem[$40:$84] := 36;
  670.   set_scr_ofs(4000);
  671.   line_comp(13*8);
  672.   setintvec(8,@int8);
  673.   setintvec(9,@int9);
  674. end;
  675.  
  676. procedure end_dos;
  677. begin
  678.   setintvec(8,@oldint8);
  679.   setintvec(9,@oldint9);
  680. end;
  681.  
  682. procedure play_sample(n : integer);
  683. begin
  684.   mem[$b800:0] := n+byte('0');
  685.   gussetfreq(10,periods[per_table[samples[n].ftune,24]]);
  686.   gussetvolume(10,gusvol[64]*amp_vol);
  687.   if samples[n].loopend > 2 then
  688.     gusplayvoice(10,8,gus_addr[n]+2,
  689.                       gus_addr[n]+samples[n].loopstart,
  690.                       gus_addr[n]+samples[n].loopend)
  691.   else gusplayvoice(10,2,gus_addr[n]+2,
  692.                          gus_addr[n]+2,
  693.                          gus_addr[n]+samples[n].length);
  694.  
  695. end;
  696.  
  697. procedure menu;
  698. var
  699. ch : char;
  700. playing,clr : boolean;
  701. start_chn : integer;
  702. begin
  703.   clr := true;
  704.   start_chn := 0;
  705.   pause := 0;
  706.   old_row := 666;
  707.   start_sample := 1;
  708.   hide_cursor;
  709.   setvgapal(col_back,col_backr,col_backg,col_backb);
  710.   show_pic;
  711.   playing := true;
  712.   start_playing;
  713.   repeat
  714.     show_ptn(start_chn,clr);
  715.     clr := false;
  716.     ch := readkey;
  717.     case ch of
  718.       '+' : if amp_vol < 18 then inc(amp_vol);
  719.       '-' : if amp_vol > 0 then dec(amp_vol);
  720.       '<' : if start_sample > 1 then dec(start_sample);
  721.       '>' : if start_sample < 11 then inc(start_sample);
  722.       ',' : if start_chn > 0 then begin
  723.               dec(start_chn);
  724.               clr := true;
  725.             end;
  726.       '.' : if start_chn < header.chns-4 then begin
  727.               inc(start_chn);
  728.               clr := true;
  729.             end;  
  730.       'p' : if pause = 0 then begin
  731.               pause := speed;
  732.               speed := 0;
  733.             end else begin
  734.               speed := pause;
  735.               pause := 0;
  736.             end;
  737.       'r' : if playing then begin
  738.               stop_playing;
  739.               playing := false;
  740.             end else begin
  741.               clr := true;
  742.               start_playing;
  743.               playing := true;
  744.             end;
  745.       'v' : if vblank then vblank := false
  746.             else vblank := true;
  747.       #8 : begin      {bkspc}
  748.              jump := 1;
  749.              new_ptn := cur_ptn;
  750.              new_row := 0;
  751.              clr := true;
  752.            end;
  753.       #0 : begin
  754.              ch := readkey;
  755.              case ch of
  756.                #81 : if speed < 31 then begin  {pgdn}
  757.                        inc(nspeed);
  758.                        inc(speed);
  759.                      end;
  760.                #73 : if speed > 0 then begin   {pgup}
  761.                        dec(nspeed);
  762.                        dec(speed);
  763.                      end;
  764.                #59..#66 : if byte(ch)-59 < header.chns then begin  {F1-F8}
  765.                             channels[byte(ch)-59].on :=
  766.                               channels[byte(ch)-59].on xor 1;
  767.                             gusstopvoice(byte(ch)-58);
  768.                           end;    
  769.                #75 : begin    {left arrow}
  770.                        jump := 1;
  771.                        if cur_ptn > 0 then new_ptn := cur_ptn-1;
  772.                        new_row := 0;
  773.                        clr := true;
  774.                      end;
  775.                #77 : begin    {right arrow}
  776.                        jump := 1;
  777.                        if cur_ptn < header.length-1 then
  778.                          new_ptn := cur_ptn+1;
  779.                        new_row := 0;
  780.                        clr := true;
  781.                      end;
  782.              end;
  783.            end;
  784.       '!' : begin
  785.               textmode(co80);
  786.               exec(getenv('COMSPEC'),'');
  787.               textmode(co80+font8x8);
  788.               hide_cursor;
  789.               setvgapal(col_back,col_backr,col_backg,col_backb);
  790.               show_pic;
  791.               old_row := 666;
  792.             end;
  793.       '"' : begin
  794.               init_dos;
  795.               exec(getenv('COMSPEC'),'');
  796.               end_dos;
  797.               textmode(co80+font8x8);
  798.               hide_cursor;
  799.               setvgapal(col_back,col_backr,col_backg,col_backb);
  800.               show_pic;
  801.               old_row := 666;
  802.             end;
  803.     end;
  804.   until ch = #27;
  805.   stop_playing;
  806. end;
  807.  
  808. function exists(s : string) : boolean;
  809. var
  810. f : file of byte;
  811. i : integer;
  812. begin
  813.   assign(f,s);
  814.   {$i-}
  815.   reset(f);
  816.   i := ioresult;
  817.   {$i+}
  818.   if i = 0 then begin
  819.     close(f);
  820.     exists := true;
  821.   end else exists := false;
  822. end;
  823.  
  824. function addext(str,ext: string) : string;
  825. begin
  826.   if pos('.',str) > 0 then addext := str
  827.   else addext := str+ext;
  828. end;
  829.  
  830. function findgus : word;
  831. var
  832. n,c,i : word;
  833. begin
  834.   if getenv('ultrasnd') = '' then begin
  835.     findgus := 0;
  836.     exit;
  837.   end;
  838.   val(copy(getenv('ultrasnd'),1,3),n,c);
  839.   if c <> 0 then begin
  840.     findgus := 0;
  841.     exit;
  842.   end;
  843.   case n of
  844.     210 : i := $210;
  845.     220 : i := $220;
  846.     230 : i := $230;
  847.     240 : i := $240;
  848.     250 : i := $250;
  849.     260 : i := $260;
  850.     270 : i := $270;
  851.   else begin
  852.     findgus := 0;
  853.     exit;
  854.   end;
  855. end;
  856. findgus := i;
  857. end;
  858.  
  859. procedure getcmd;
  860. var
  861. s : string;
  862. begin
  863.   writeln('Adrenalin module player v 0.2  By: Beta/Adrenalin');
  864.   if paramcount < 1 then begin
  865.     writeln('Usage: ADNMOD modname [/port]');
  866.     halt(0);
  867.   end;
  868.   s := addext(paramstr(1),'.mod');
  869.   if not exists(s) then begin
  870.     writeln('Module ',s,' not found!');
  871.     halt(2);
  872.   end;
  873.   mod_name := s;
  874.   if (paramcount > 1) and (copy(paramstr(2),1,1) = '/') then begin
  875.     s := copy(paramstr(2),2,3);
  876.     if s = '210' then base := $210;
  877.     if s = '220' then base := $220;
  878.     if s = '230' then base := $230;
  879.     if s = '240' then base := $240;
  880.     if s = '250' then base := $250;
  881.     if s = '260' then base := $260;
  882.     if s = '270' then base := $270;
  883.   end;
  884. end;
  885.  
  886. begin
  887.   checkbreak := false;
  888.   getcmd;
  889.   if base = $200 then if findgus > 0 then base := findgus;
  890.   gusfind;
  891.   if base = $200 then begin
  892.     writeln('GUS not found. Assuming address 220');
  893.     base := $220;
  894.     gusfind;
  895.   end;
  896.   write('GUS found at ',nibb2hex(hi(base)),byte2hex(lo(base)));
  897.   gusmem := gusfindmem;
  898.   writeln(' with ',gusmem,' bytes of memory');
  899.   gusreset;
  900.   init_mod;
  901.   load_mod(mod_name,true);
  902.   if mod_error <> 0 then case mod_error of
  903.     1 : begin
  904.           writeln('Too many channels');
  905.           halt(1);
  906.         end;
  907.     2 : begin
  908.           writeln;
  909.           writeln('Load error!');
  910.           halt(2);
  911.         end;
  912.     3 : begin
  913.           writeln;
  914.           writeln('Out of memory');
  915.           halt(2);
  916.         end;
  917.     255 : begin
  918.             writeln('Error');
  919.             halt(3);
  920.           end;
  921.   end;
  922.   textmode(co80+font8x8);
  923.   menu;
  924.   free_mod;
  925.   gusdeinit;
  926.   textmode(co80);
  927. end.
  928.  
  929.